home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CICA 1993 April
/
CICA MS Windows - April 1993.iso
/
unzipped
/
programr
/
bcpp
/
cmmdlg
/
port_.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-09-07
|
7KB
|
408 lines
{µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
{ \\\ }
{ -(j)- }
{ /juanca « }
{ ~ }
{$D ⌐ ACASA 1989-1992, All rights reserved }
{µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
{ an OO shell for DeviceContext, place in your tPort Object any method
that makes your life with GDI easier
}
UNIT PORT_;
{$C MOVEABLE DEMANDLOAD DISCARDABLE}
INTERFACE
USES
WOBJECTS,
WINTYPES;
CONST
NULL = 0;
TYPE
TPolyPoints = array[0..MaxInt div 4] of TPoint;
PPolyPoints = ^TPolyPoints;
PPort = ^TPort;
Super = TObject;
TPort = OBJECT (Super)
CONSTRUCTOR
init;
CONSTRUCTOR
initD(hdev:THandle);
CONSTRUCTOR
initGet(iwin:PWindowsObject); { get the DeviceContext from a tWindow }
CONSTRUCTOR
compatible(dc:PPort);
DESTRUCTOR
done;
virtual;
DESTRUCTOR
delete;
virtual;
FUNCTION
context:THandle;
virtual;
PROCEDURE
set_context( newHDC:THandle);
FUNCTION
isPrinter :Boolean; { always FALSE, tPrinter returns TRUE }
FUNCTION
cycle :Boolean;
virtual;
{ function to call from long painting routines,
it exists so when painting to a tPrinter,
user can interruput with the PrintAbort dlg
}
FUNCTION
select(obj :THandle):THandle;
FUNCTION
textOut(x, y:Integer; txt:pChar):Boolean;
PROCEDURE
setPixel(x, y :Integer; color :TColorRef);
PROCEDURE
moveTo(x, y:Integer);
PROCEDURE
lineTo(x, y:Integer);
FUNCTION
rectangle(x1, y1, x2, y2:Integer):Boolean;
FUNCTION
ellipse(x1, y1, x2, y2:Integer):Boolean;
FUNCTION
polyLine(var points :TPolyPoints; count :Word):Boolean;
FUNCTION
polygon(var points :TPolyPoints; count :Word):Boolean;
PROCEDURE
lp2dp(var points; count:Word);
PROCEDURE
dp2lp(var points; count:Word);
FUNCTION
compatibleBitmap(w, h :Integer):HBitmap;
PROCEDURE
save;
PROCEDURE
restore;
FUNCTION
setROP2(mode:Integer):Integer;
FUNCTION
mapMode :Integer;
PROCEDURE
setMapMode(mm :Integer);
PROCEDURE
textExtents(s :pChar; var width, height :Word);
PRIVATE
_hdc : THandle;
_win : PWindowsObject;
END;{OBJECT Super}
{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
IMPLEMENTATION
USES
WINPROCS,
STRINGS;
CONST
mm_DivFactor = 1;
PROCEDURE
{}
softYield;
var
msg :tMsg;
begin
peekMessage(msg, 0, 0, Word(-1), pm_NoRemove)
end;
CONSTRUCTOR
TPort.
{}
init;
begin
Super.init;
_win := nil;
_hdc := null
end;
CONSTRUCTOR
TPort.
{}
initD(hdev:THandle);
begin
Super.init;
_win := nil;
_hdc := hdev
end;
CONSTRUCTOR
TPort.
{}
initGet(iwin :PWindowsObject);
begin
Super.init;
_win := iwin;
if _win <> nil then
_hdc := getDC(_win^.hwindow)
else
_hdc := null
end;
CONSTRUCTOR
TPort.
{}
compatible(dc:PPort);
begin
TPort.initD(createCompatibleDC(dc^.context));
end;
DESTRUCTOR
TPort.
{}
done;
begin
if _win <> nil
then
releaseDC(_win^.hwindow, context);
_win := nil;
_hdc := null
end;
DESTRUCTOR
TPort.
{}
delete;
begin
if _hdc <> null
then
deleteDC(_hdc);
_win := nil;
_hdc := null
end;
FUNCTION
TPort.
{}
context:THandle;
begin
context := _hdc
end;
PROCEDURE
TPort.
{}
set_context(newHDC :THandle);
begin
_hdc := newHDC;
_win := nil
end;
FUNCTION
tPort.
{}
isPrinter :Boolean;
begin
isPrinter := FALSE
end;
FUNCTION
TPort.
{}
cycle:Boolean;
begin
cycle := TRUE;
softYield
end;
{}
{}
FUNCTION
TPort.
{}
select(obj :THandle):THandle;
begin
select := selectObject(context, obj)
end;
{}
{}
PROCEDURE
TPort.
{}
setPixel(x, y :Integer; color :TColorRef);
begin
WinProcs.setPixel(context, x, y, color)
end;
{}
{}
PROCEDURE
TPort.
{}
moveTo(x, y:Integer);
begin
WinProcs.moveTo(context, x, y)
end;
{}
{}
PROCEDURE
TPort.
{}
lineTo(x, y:Integer);
begin
WinProcs.lineTo(context, x, y)
end;
FUNCTION
TPort.
{}
rectangle(x1, y1, x2, y2:Integer):Boolean;
begin
rectangle := Word(WinProcs.rectangle(context, x1, y1, x2, y2)) <> 0
end;
{}
{}
FUNCTION
TPort.
{}
ellipse(x1, y1, x2, y2:Integer):Boolean;
begin
ellipse := Word(WinProcs.ellipse(context, x1, y1, x2, y2)) <> 0
end;
FUNCTION
TPort.
{}
polygon(var points :TPolyPoints; count :Word):Boolean;
begin
polygon := 0 <> Word(WINPROCS.polygon(context, points, count))
end;
FUNCTION
TPort.
{}
polyLine(var points :TPolyPoints; count :Word):Boolean;
begin
polyLine := 0 <> Word(WINPROCS.polyLine(context, points, count))
end;
{}
{}
FUNCTION
TPort.
{}
textOut(x, y:Integer; txt:pChar):Boolean;
begin
textOut := 0 <> Word(WinProcs.textOut(context, x, y, txt, strLen(txt)));
end;
PROCEDURE
TPort.
{}
lp2dp(var points; count:Word);
begin
LPToDP(context, points, count)
end;
PROCEDURE
TPort.
{}
dp2lp(var points; count:Word);
begin
DPToLP(context, points, count)
end;
FUNCTION
TPort.
{}
compatibleBitmap(w, h :Integer):HBitmap;
begin
compatibleBitmap := createCompatibleBitmap(context, w, h)
end;
PROCEDURE
TPort.
{}
save;
begin
saveDC(context);
end;
PROCEDURE
TPort.
{}
restore;
begin
restoreDC(context, -1)
end;
FUNCTION
TPort.
{}
setROP2(mode:Integer):Integer;
begin
setROP2 := WinProcs.setROP2(context, mode)
end;
FUNCTION
TPort.
{}
mapMode :Integer;
begin
mapMode := getMapMode(context)
end;
PROCEDURE
TPort.
{}
setMapMode(mm :Integer);
begin
WinProcs.setMapMode(context, mm)
end;
PROCEDURE
TPort.
{}
textExtents(s :pChar; var width, height :Word);
var
size :Longint;
begin
size := getTextExtent(context, s, strLen(s));
height := hiWord(size);
width := loWord(size)
end;
END.